;File:	DOCTOR.LSP		    03/06/91		Soft Warehouse, Inc.


;		* * *	The Doctor (Eliza) Program   * * *

(PROGN
  ((GETD 'WINDOWS T))
  (TERPRI 2)
  (WRITE-LINE "Please relax while the Doctor is reviewing your records.")
  (WRITE-LINE "He will be ready to talk to you in just a few seconds.")
  (TERPRI)
  (WRITE-LINE " 	   - the Doctor's secretary")
  (TERPRI) )

(DEFUN DOCTOR (
    SENTENCE KEYSTACK MEMSTACK FLIPFLOP )
  (TERPRI)
  (WRITE-SENTENCE "D:  I am at your service; just tell me anything that ")
  (WRITE-SENTENCE "troubles or concerns you.  Please end your sentences ")
  (WRITE-SENTENCE "with a period, a question mark, or an exclamation mark, ")
  (WRITE-SENTENCE "and then press the RETURN or ENTER key.  When you are ")
  (WRITE-SENTENCE "ready to quit our session, just enter \"GOODBYE.\" and ")
  (WRITE-SENTENCE "press the RETURN key.")
  (TERPRI)
  (SETNONE)
  (LOOP
    (TERPRI)
    (WRITE-STRING "P:  ")
    (SETQ SENTENCE (READ-SENTENCE))
    ((NULL SENTENCE)
      (TERPRI)
      (WRITE-STRING "D:  ") )
    (SETQ SENTENCE (MAKE-SENTENCE SENTENCE)
	  KEYSTACK (CDR SENTENCE)
	  SENTENCE (CAR SENTENCE))
    (WRITE-STRING "D:  ")
    ((MEMBER 'GOODBYE SENTENCE))
    (TONE NIL 250)			;An optional short pause
    (PRINT-SENTENCE (ANALYZE))
    (TERPRI)
    (DOCTOR-MEMORY) )
  (WRITE-SENTENCE "I hope I have been of some service, let's get ")
  (WRITE-SENTENCE "together again sometime.")
  (WRITE-BYTE 13)
  'D )

(DEFUN MAKE-SENTENCE (SENTENCE
    WORD FLAG RULE KEYSTACK)
  (SETQ KEYSTACK (CONS))
  (LOOP
    ((NULL SENTENCE)
      (CONS (REVERSE RULE) KEYSTACK) )
    (SETQ WORD (CAR SENTENCE))
    ( ((NUMBERP WORD)
	(SETQ WORD (COND
	  ((ZEROP WORD) ZERO)
	  ((EQ WORD 1) ONE)
	  ((EQ WORD 2) TWO)
	  (NUMBER) )) ) )
    ((MEMBER WORD PCTLIS)
      (SETQ FLAG (MAKE-SENTENCE (CDR SENTENCE)))
      ((NULL (CDR KEYSTACK)) FLAG)
      ((AND (CDDR FLAG) (NOT (>
	  (GETP (CDR KEYSTACK) 'PRIORITY)
	  (GETP (CDDR FLAG) 'PRIORITY) )))
	FLAG )
      (CONS (REVERSE RULE) KEYSTACK) )
    ( ((GETP WORD 'MEMR)
	(SETQ MEMSTACK (APPEND (GETP WORD 'MEMR) MEMSTACK)) ) )
    ( ((GETP WORD 'PRIORITY)
	((AND (CDR KEYSTACK) (> (GETP WORD 'PRIORITY)
	    (GETP (CDR KEYSTACK) 'PRIORITY) ))
	  (RPLACD KEYSTACK (CONS (CDR KEYSTACK) (CDR WORD))) )
	(BCONC (CDR WORD) KEYSTACK) ) )
    (SETQ WORD (COND
	((GETP WORD 'TRANSLATION))
	(WORD) ))
    (PUSH WORD RULE)
    (POP SENTENCE) ) )

(DEFUN ANALYZE (
    RULES PARSLST CR EXIT)
  (SETQ FLIPFLOP (NOT FLIPFLOP))
  (BCONC (GETP 'NONE (COND
      ((NULL FLIPFLOP)
	'MEM )
      ('LASTRESORT) ))
    KEYSTACK )
  (POP KEYSTACK)
  (SETQ RULES (GETP KEYSTACK 'RULES))
  (LOOP
    (SETQ EXIT NIL)
    ( ((OR (NULL RULES) (EQ (CAR RULES) 'NEWKEY))
	(SETQ KEYSTACK (CAR KEYSTACK))
	(SETQ RULES (GETP KEYSTACK 'RULES)) )
      ((ATOM (CAR RULES))
	(SETQ RULES (GETP (CAR RULES) 'RULES)) )
      (SETQ PARSLST (CONS))
      ((NOT (TEST-SENTENCE (CAAR RULES) SENTENCE))
	(POP RULES) )
      (SETQ RULES (CAR (ADVANCE RULES)))
      (SETQ CR (CAR RULES))
      ((ATOM CR))
      ((EQ (CAR CR) 'PRE)
	(SETQ SENTENCE (RECONSTRUCT (CADR CR) PARSLST))
	(SETQ RULES (CDDR CR)) )
      (SETQ EXIT T) )
    ((EVAL EXIT)
      (RECONSTRUCT CR PARSLST) ) ) )

(DEFUN DOCTOR-MEMORY (
    PARSLST X)
  (LOOP
    ((NULL MEMSTACK))
    (SETQ PARSLST (CONS))
    ( ((TEST-SENTENCE (CAAR MEMSTACK) SENTENCE)
	(SETQ X (CDAR (CADR (GETP 'NONE 'MEM))))
	(RPLACA X (CONS (CAR X) (CONS
	  (RECONSTRUCT (CAAR (ADVANCE MEMSTACK)) PARSLST)
	  (CDAR X) ))) ) )
    (POP MEMSTACK) ) )

(DEFUN ADVANCE (RULES)
  (RPLACA (CDAR RULES) (COND
    ((NULL (CDAR (CDAR RULES)))
      (CDDAR RULES) )
    ((CDAR (CDAR RULES))) )) )

(DEFUN RECONSTRUCT (RULE PARSLST
    WORD SENTENCE V1)
  (LOOP
    ((NULL RULE)
      (REVERSE SENTENCE) )
    (SETQ WORD (CAR RULE))
    ( ((NUMBERP WORD)
	(SETQ WORD (DOCNTH PARSLST WORD))
	(SETQ V1 (CAR WORD))
	(LOOP
	  ((EQ V1 (CADR WORD)))
	  (PUSH (POP V1) SENTENCE) ) )
      (PUSH WORD SENTENCE) )
    (POP RULE) ) )

(DEFUN TEST-SENTENCE (D S
    CD PSV)
  (SETQ PSV (CDR PARSLST))
  (LOOP
    ((NULL D)
      ((NOT S)
	(SETQ PARSLST (CAR PARSLST))
	T )
      (RN) )
    (SETQ CD (CAR D))
    ((ZEROP CD)
      (TCONC PARSLST S)
      (POP D)
      ((NULL D)
	(SETQ PARSLST (CAR PARSLST))
	T )
      (LOOP
	((TEST-SENTENCE D S) T)
	(POP S)
	((NULL S)
	  (RN) ) ) )
    ((NOT (RNP))
      (RN) )
    (POP S)
    (POP D) ) )

(DEFUN RN ()
  (RPLACD PARSLST (COND
    ((NOT PSV) NIL)
    ((RPLACD PSV NIL)) )) NIL)

(DEFUN RNP ()
  ((NULL S) NIL)
  ((NUMBERP CD)
    (TCONC PARSLST S)
    (SETQ S (DOCNTH S CD)) )
  ((COND
    ((ATOM CD)
      (EQ CD (CAR S)) )
    ((CAR CD)
      (MEMBER (CAR S) CD) )
    ((TEST4 (CAR S) (CDR CD))) )
      (TCONC PARSLST S) T ) )

(DEFUN TEST4 (CS L)
  (LOOP
    ((GETP CS (POP L)))
    ((NULL L) NIL) ) )

(DEFUN BCONC (X Y)
  (SETQ X (CONS NIL X))
  ((NULL Y)
    (CONS X X) )
  ((NULL (CAR Y))
    (RPLACD Y X)
    (RPLACA Y X) )
  (RPLACA (CAR Y) X)
  (RPLACA Y (CAAR Y)) )

(DEFUN GETP (X Y)
  (LOOP
    (SETQ X (CDR X))
    ((NULL X) NIL)
    ((EQ (CAR X) Y)
      (CADR X) )
    (POP X) ) )

(DEFUN PUTP (X Y Z XX)
  (SETQ XX X)
  (LOOP
    ((NULL (CDR X))
      (RPLACD X (LIST Y Z)) )
    ((EQ (CADR X) Y)
      (RPLACA (CDDR X) Z) )
    (SETQ X (CDDR X))
    ((NULL X)
      (RPLACD XX (LIST* Y Z (CDR XX))) ) )
  Z )

(SETQ XXXX 'XXXX)

(DEFUN SETNONE (A)
  (SETQ A XXXX)
  (RPLACD A (GETP 'NONE 'LASTRESORT))
  (PUTP 'NONE 'MEM (LIST 'RULES (LIST (LIST (LIST 0) (CONS) A))) ) )

(DEFUN DOCNTH (X Y)
  ((ZEROP Y)
    (CONS NIL X) )
  (LOOP
    (DECQ Y)
    ((ZEROP Y) X)
    (POP X) ) )

(DEFUN RPLQQ (NLAMBDA ARG
  (RPLACD (CAR ARG) (CDR ARG))
  (CAR ARG) ))

; The Doctor Program Console Interface Routines

(DEFUN READ-SENTENCE (SENTENCE
    WORD )
  (LOOP
    (SETQ WORD (STRING-UPCASE (READ-ATOM)))
    ((MEMBER WORD TRMLIS)
      (REVERSE SENTENCE) )
    ( ((MEMBER WORD SEPLIS)
	(PUSH (PACK* (POP SENTENCE) WORD (STRING-UPCASE (READ-ATOM)))
	      SENTENCE) )
      (PUSH WORD SENTENCE) ) ) )

(DEFUN PRINT-SENTENCE (SENTENCE
    WORD )
  (PRINC (STRING-CAPITALIZE (POP SENTENCE)))
  (LOOP
    ((NULL SENTENCE)
      (WRITE-STRING '?) )
    (SETQ WORD (POP SENTENCE))
    ((MEMBER WORD TRMLIS)
      (PRINC WORD) )
    ( ((OR (NULL SENTENCE)
	   (MEMBER (CAR SENTENCE) TRMLIS)
	   (MEMBER (CAR SENTENCE) PCTLIS) )
	(PRETERPRI WORD) ) )
    ( ((MEMBER WORD PCTLIS))
      (SPACES 1) )
    ( ((MEMBER WORD CAPLIS)
	(PRINC (STRING-CAPITALIZE WORD)) )
      (PRINC (STRING-DOWNCASE WORD)) ) ) )

(DEFUN PRETERPRI (WORD)
  ((> (+ (SPACES) (LENGTH WORD)) (CADDDR (MAKE-WINDOW)))
    (TERPRI) ) )

(SETQ CAPLIS '(I HAWAII))
(SETQ TRMLIS '("." ! ?))
(SETQ PCTLIS '("," ";" "(" ")" ":"))
(SETQ SEPLIS '("'" "-"))

(DEFUN WRITE-SENTENCE (SENTENCE
    INDEX COLS *AUTO-NEWLINE*)
  (SETQ COLS (CADDDR (MAKE-WINDOW)))
  (LOOP
    ((EQ SENTENCE ""))
    (SETQ INDEX (- COLS (COLUMN)))
    ((NULL (CHAR SENTENCE INDEX))
      (WRITE-STRING SENTENCE) )
    (LOOP
      ((EQ (CHAR SENTENCE INDEX) " ")
	(WRITE-LINE (SUBSTRING SENTENCE 0 (SUB1 INDEX)))
	(SETQ SENTENCE (STRING-LEFT-TRIM " " (SUBSTRING SENTENCE INDEX))) )
      ((ZEROP INDEX)
	((ZEROP (COLUMN))
	  (WRITE-LINE (SUBSTRING SENTENCE 0 (SUB1 COLS)))
	  (SETQ SENTENCE (STRING-LEFT-TRIM " " (SUBSTRING SENTENCE COLS))) )
	(TERPRI) )
      (DECQ INDEX) ) ) )

; The Doctor Program Script

(RPLQQ NONE LASTRESORT (RULES (
      ((0)
	(NIL)
	(I AM NOT SURE I UNDERSTAND YOU FULLY ".")
	(PLEASE GO ON ".")
	(WHAT DOES THAT SUGGEST TO YOU)
	(WHAT ELSE WOULD YOU LIKE TO DISCUSS)
	(WHY DO YOU SAY THAT JUST NOW) ) )))

(RPLQQ SORRY PRIORITY 2 RULES (
      ((0)
	(NIL)
	(PLEASE "DON'T" APOLOGIZE ".")
	(APOLOGIES ARE NOT NECESSARY ".")
	(WHAT FEELINGS DO YOU HAVE WHEN YOU APOLOGIZE) ) ))

(RPLQQ DONT TRANSLATION "DON'T")

(RPLQQ CANT TRANSLATION "CAN'T")

(RPLQQ WONT TRANSLATION "WON'T")

(RPLQQ REMEMBER PRIORITY 5 RULES (
      ((REMEMBER 0)
	  (NIL)
	  (PRE (DO I REMEMBER 2) REMEMBER) )
      ((YOU REMEMBER 0)
	(NIL)
	(DO YOU OFTEN THINK OF 3)
	(WHAT ELSE DOES THINKING OF 3 BRING TO MIND)
	(WHAT ELSE DO YOU REMEMBER)
	(WHY DO YOU REMEMBER 3 JUST NOW)
	(WHAT IN THE PRESENT SITUATION REMINDS YOU OF 3)
	(WHAT IS THE CONNECTION BETWEEN ME AND 3) )
      ((DO I REMEMBER 0)
	(NIL)
	(WHY DID YOU THINK I WOULD FORGET 4)
	(WHY DO YOU THINK I SHOULD RECALL 4 NOW)
	(WHAT ABOUT 4)
	WHAT
	(YOU MENTIONED 4) )
      ((0)
	(NIL)
	NEWKEY ) ))

(RPLQQ IF PRIORITY 3 RULES (
      ((0 IF 0 HAD 0)
	(NIL)
	(PRE (1 2 3 MIGHT HAVE 5) IF) )
      ((0 IF 0)
	(NIL)
	(DO YOU THINK ITS LIKELY THAT 3)
	(DO YOU WISH THAT 3)
	(WHAT DO YOU THINK ABOUT 3)
	("REALLY," IF 3) ) ))

(RPLQQ DREAMT PRIORITY 4 RULES (
      ((0 YOU DREAMT 0)
	(NIL)
	(REALLY 4)
	(HAVE YOU EVER FANTASIZED 4 WHILE YOU WERE AWAKE)
	(HAVE YOU DREAMT 4 BEFORE)
	DREAM
	NEWKEY)
      ((0) (NIL) DREAM NEWKEY) ))

(RPLQQ DREAMED TRANSLATION DREAMT PRIORITY 4 RULES (DREAMT))

(RPLQQ DREAM PRIORITY 3 RULES (
      ((0 YOU DREAM (OF ABOUT) 0)
	(NIL)
	(WHAT MIGHT 5 REPRESENT)
	(WHAT DOES 5 SUGGEST TO YOU)
	(HOW DOES THAT DREAM RELATE TO YOUR PROBLEM) )
      ((0)
	(NIL)
	(WHAT DOES THAT DREAM SUGGEST TO YOU)
	(WHAT DO YOU DREAM ABOUT)
	(WHAT PERSONS APPEAR IN YOUR DREAMS)
	(WOULD YOU LIKE TO FLEE FROM REALITY)
	NEWKEY ) ))

(RPLQQ DREAMS TRANSLATION DREAM PRIORITY 3 RULES (DREAM))

(RPLQQ HOW RULES (WHAT) PRIORITY 0)

(RPLQQ WHEN PRIORITY 0 RULES (
      ((WHEN (DO DID DOES WILL) 0)
	(NIL)
	XXWHAT )
      ((0)
	(NIL)
	(IS THERE ANY OTHER TIME)
	(WHY "THEN," DO YOU SUPPOSE) ) ))

(RPLQQ ALIKE PRIORITY 10 RULES (DIT))

(RPLQQ SAME PRIORITY 3 RULES (DIT))

(RPLQQ CERTAINLY PRIORITY 0 RULES (YES))

(RPLQQ FEEL BELIEF T)

(RPLQQ THINK BELIEF T)

(RPLQQ BELIEVE BELIEF T)

(RPLQQ WISH BELIEF T)

(RPLQQ BET BELIEF T)

(RPLQQ MY MEMR (
      ((YOUR 2 0)
	(NIL)
	("LET'S" DISCUSS FURTHER WHY YOUR 2 3 ".")
	(EARLIER YOU SAID YOUR 2 3 ".")
	(BUT YOUR 2 3 ".")
	(DOES THAT HAVE ANYTHING TO DO WITH THE FACT THAT YOUR 2 3) )
      ((0 YOUR 1 0)
	(NIL)
	(EARLIER YOU SAID YOUR 3 4)
	(BUT YOUR 3 4)
	(DOES THAT HAVE ANYTHING TO DO WITH YOUR 3 4) )
      ((0 YOUR 1)
	(NIL)
	(WOULD YOU LIKE TO DISCUSS YOUR 3)
	(PERHAPS THAT CONCERNS YOUR 3 ".")
	(TELL ME MORE ABOUT YOUR 3 ".") ) )

    PRIORITY 0 TRANSLATION YOUR RULES (
      ((0 YOUR 0 (NIL FAMILY) 0)
	(NIL)
	(TELL ME MORE ABOUT YOUR FAMILY ".")
	(WHO ELSE IN YOUR FAMILY 5)
	(YOUR 4)
	(WHAT ELSE COMES TO MIND WHEN YOU THINK OF YOUR 4) )
      ((YOUR 2 0)
	(NIL)
	(IS IT IMPORTANT TO YOU THAT YOUR 2 3)
	(DO YOU SUPPOSE ANYONE "ELSE'S" 2 3)
	(WHAT MAKES YOU THINK YOUR 2 3)
	(SUPPOSE I "DIDN'T" BELIEVE THAT YOUR 2 3 ".") )
      ((0 YOUR 1)
	(NIL)
	(YOUR 3)
	(WHY DO YOU SAY YOUR 3)
	(WHO ELSE KNOWS ABOUT YOUR 3)
	(WHY DO YOU MENTION YOUR 3 JUST NOW)
	(WHY IS YOUR 3 IMPORTANT TO YOU)
	(DO YOU OFTEN DISCUSS YOUR 3) ) ))

(RPLQQ PERHAPS PRIORITY 0 RULES (
      ((0)
	(NIL)
	(YOU "DON'T" SEEM QUITE CERTAIN ".")
	(WHY THE UNCERTAIN TONE)
	("CAN'T" YOU BE MORE POSITIVE)
	(YOU "AREN'T" SURE)
	("DON'T" YOU KNOW) ) ))

(RPLQQ MAYBE PRIORITY 0 RULES (PERHAPS))

(RPLQQ NAME PRIORITY 15 RULES (
      ((0)
	(NIL)
	(I AM NOT INTERESTED IN NAMES ".")
	("I'VE" TOLD YOU BEFORE I "DON'T" CARE ABOUT
		NAMES - PLEASE CONTINUE ".") ) ))

(RPLQQ DEUTSCH PRIORITY 0 RULES (
      ((0)
	(NIL)
	(I AM "SORRY," I SPEAK ONLY ENGLISH) ) ))

(RPLQQ FRANCAIS PRIORITY 0 RULES (DEUTSCH))

(RPLQQ SVENSKA PRIORITY 0 RULES (DEUTSCH))

(RPLQQ ITALIANO PRIORITY 0 RULES (DEUTSCH))

(RPLQQ ESPANOL PRIORITY 0 RULES (DEUTSCH))

(RPLQQ HELLO PRIORITY 0 RULES (
      ((0)
	(NIL)
	("HI," HOW ARE YOU) ) ))

(RPLQQ COMPUTER PRIORITY 8 RULES (
      ((0)
	(NIL)
	(DO COMPUTERS WORRY YOU)
	(WHY DO YOU MENTION COMPUTERS)
	(WHAT DO YOU THINK MACHINES HAVE TO DO WITH YOUR PROBLEM)
	("DON'T" YOU THINK COMPUTERS CAN HELP PEOPLE) ) ))

(RPLQQ MACHINE PRIORITY 8 RULES (COMPUTER))

(RPLQQ MACHINES PRIORITY 8 RULES (COMPUTER))

(RPLQQ COMPUTERS PRIORITY 10 RULES (COMPUTER))

(RPLQQ AM PRIORITY 0 TRANSLATION ARE RULES (
      ((ARE YOU 0)
	(NIL)
	(DO YOU BELIEVE YOU ARE 3)
	(WOULD YOU WANT TO BE 3)
	(YOU WISH I WOULD TELL YOU YOU ARE 3 ".")
	(WHAT WOULD IT MEAN IF YOU WERE 3)
	XXWHAT )
      ((0)
	(NIL)
	(WHY DO YOU SAY "'AM'")
	(I "DON'T" UNDERSTAND THAT) ) ))

(RPLQQ ARE PRIORITY 0 RULES (
      ((THERE (ARE IS) (NO NOT) 0)
	(NIL)
	(WHAT IF THERE WERE 4)
	(DID YOU THINK THERE MIGHT BE 4)
	(PRE (THERE 2 4) ARE) )
      ((THERE (ARE IS) 0)
	(NIL)
	(2 THERE REALLY 3)
	(WHY 2 THERE 3)
	(HOW 3 THE 4 RELATED TO YOU) )
      ((ARE I 0)
	(NIL)
	(WHY ARE YOU INTERESTED IN WHETHER I AM 3 OR NOT)
	(WOULD YOU PREFER IF I "WEREN'T" 3)
	(PERHAPS I AM 3 IN YOUR FANTASIES ".")
	(DO YOU SOMETIMES THINK I AM 3)
	XXWHAT )
      ((ARE 0)
	(NIL)
	XXWHAT )
      ((0 1 (ARE IS) NOT 0)
	(NIL)
	(POSSIBLY THAT IS FOR THE BETTER ".")
	(WHAT IF 2 WERE 5)
	(WHAT DO YOU REALLY KNOW ABOUT 2))
      ((0 (ARE IS) 0)
	(NIL)
	(SUPPOSE 1 WERE NOT 3 ".")
	(POSSIBLY 1 REALLY 2 NOT 3 ".")
	(TELL ME MORE ABOUT 1 ".")
	(DID YOU THINK 1 MIGHT NOT BE 3)
	(1 PERHAPS 2 3 ".") ) ))

(RPLQQ YOUR PRIORITY 0 TRANSLATION MY RULES (
      ((0 MY 1)
	(NIL)
	(WHY ARE YOU CONCERNED OVER MY 3)
	(WHAT ABOUT YOUR OWN 3)
	(ARE YOU WORRIED ABOUT SOMEONE "ELSE'S" 3)
	("REALLY," MY 3))
      ((MY 0)
	(NIL)
	(PERHAPS YOUR OWN 2 ".")
	(ARE YOU WORRIED THAT MY 2) ) ))

(RPLQQ WAS PRIORITY 2 RULES (
      ((WAS YOU 0)
	(NIL)
	(WHAT IF YOU WERE 3)
	(DO YOU THINK YOU WERE 3)
	(WERE YOU 3)
	(WHAT WOULD IT MEAN IF YOU WERE 3)
	XXWHAT)
      ((YOU WAS 0)
	(NIL)
	(WERE YOU REALLY)
	(WHY DO YOU TELL ME YOU WERE 3 NOW)
	(PERHAPS I ALREADY KNEW YOU WERE 3 "."))
      ((WAS I 0)
	(NIL)
	(WOULD YOU LIKE TO BELIEVE I WAS 3)
	(WHAT SUGGESTS THAT I WAS 3)
	(WHAT DO YOU THINK)
	(PERHAPS I WAS 3 ".")
	(WHAT IF I HAD BEEN 3) ) ))

(RPLQQ WERE PRIORITY 0 TRANSLATION WAS RULES (WAS))

(RPLQQ ME TRANSLATION YOU)

(RPLQQ "YOU'RE" PRIORITY 0 TRANSLATION "I'M" RULES (
      ((0 "I'M" 0)
	(NIL)
	(PRE (I ARE 3) YOU) ) ))

(RPLQQ "I'M" PRIORITY 0 TRANSLATION "YOU'RE" RULES (
      ((0 "YOU'RE" 0)
	(NIL)
	(PRE (YOU ARE 3) I) ) ))

(RPLQQ MYSELF TRANSLATION YOURSELF)

(RPLQQ YOURSELF TRANSLATION MYSELF)

(RPLQQ MOTHER FAMILY T)

(RPLQQ MOM TRANSLATION MOTHER FAMILY T)

(RPLQQ DAD TRANSLATION FATHER FAMILY T)

(RPLQQ FATHER FAMILY T)

(RPLQQ SISTER FAMILY T)

(RPLQQ BROTHER FAMILY T)

(RPLQQ WIFE FAMILY T)

(RPLQQ CHILDREN FAMILY T)

(RPLQQ I PRIORITY 0 TRANSLATION YOU RULES (
      ((0 YOU (WANT NEED) 0)
	(NIL)
	(WHAT WOULD IT MEAN TO YOU IF YOU GOT 4)
	(WHY DO YOU WANT 4)
	(WHAT WOULD GETTING 4 MEAN TO YOU))
      ((0 YOU ARE 0 (SAD UNHAPPY DEPRESSED SICK ILL) 0)
	(NIL)
	(I AM SORRY TO HEAR YOU ARE 5 ".")
	(DO YOU THINK COMING HERE WILL HELP YOU NOT TO BE 5)
	(CAN YOU EXPLAIN WHAT MADE YOU 5))
      ((0 YOU ARE 0 (HAPPY ELATED GLAD BETTER) 0)
	(NIL)
	(HOW HAVE I HELPED YOU TO BE 5)
	(HAS YOUR TREATMENT MADE YOU 5)
	(WHAT MAKES YOU 5 JUST NOW))
      ((0 YOU (NIL BELIEF) YOU 0)
	(NIL)
	(DO YOU REALLY THINK SO)
	(BUT YOU ARE NOT SURE YOU 5)
	(DO YOU REALLY DOUBT YOU 5))
      ((0 YOU 0 (NIL BELIEF) 0 I 0)
	(NIL)
	(PRE (6 7) YOU))
      ((0 YOU ARE 0)
	(NIL)
	(IS IT BECAUSE YOU ARE 4 THAT YOU CAME TO ME)
	(HOW LONG HAVE YOU BEEN 4)
	(DO YOU BELIEVE IT NORMAL TO BE 4)
	(DO YOU ENJOY BEING 4))
      ((0 YOU ("CAN'T" CANNOT) 0)
	(NIL)
	(HOW DO YOU KNOW YOU "CAN'T" 4)
	(HAVE YOU TRIED)
	(PERHAPS YOU COULD 4 NOW ".")
	(DO YOU REALLY WANT TO BE ABLE TO 4))
      ((0 YOU ("DON'T" "WON'T") 0)
	(NIL)
	("DON'T" YOU REALLY 4)
	(WHY "DON'T" YOU 4)
	(DO YOU WISH YOU DID 4)
	(DOES THAT TROUBLE YOU))
      ((0 YOU FEEL 0)
	(NIL)
	(TELL ME MORE ABOUT SUCH FEELINGS ".")
	(DO YOU OFTEN FEEL 4)
	(DO YOU ENJOY FEELING 4)
	(OF WHAT DOES FEELING 4 REMIND YOU))
      ((YOU 0 I)
	(NIL)
	(PERHAPS IN YOUR FANTASY WE 2 EACH OTHER ".")
	(DO YOU WISH TO 2 ME)
	(YOU SEEM TO NEED TO 2 ME ".")
	(DO YOU 2 ANYONE ELSE))
      ((0 YOU (NIL EMOTION) 0)
	(NIL)
	(WHAT ELSE DO YOU 3)
	(TELL ME MORE ABOUT 4 ".")
	(WHY DO YOU 3 4)
	(I DOUBT THAT YOU REALLY 3 4 "."))
      ((0 YOU 1 0)
	(NIL)
	(YOU SAY 2 3 4)
	(CAN YOU ELABORATE ON THAT)
	(DO YOU SAY 2 3 4 FOR SOME SPECIAL REASON)
	(TELL ME MORE ABOUT YOURSELF ".")
	(OH? 2 3 4)
	("THAT'S" QUITE INTERESTING ".")))
    MEMR (
      ((0 YOU ARE 0)
	(NIL)
	(ARE YOU STILL 4)
	(EARLIER YOU SAID YOU WERE 4 ".")
	(MAYBE NOW WE CAN DISCUSS WHY YOU ARE 4 ".")
	(DID YOU TELL ME YOU WERE 4))))

(RPLQQ YOU PRIORITY 0 TRANSLATION I RULES (
      ((0 I REMIND YOU OF 0)
	(NIL)
	DIT)
      ((0 I ARE 0)
	(NIL)
	(WHAT MAKES YOU THINK I AM 4)
	(DOES IT PLEASE YOU TO BELIEVE I AM 4)
	(PERHAPS YOU WOULD LIKE TO BE 4 ".")
	(DO YOU SOMETIMES WISH YOU WERE 4))
      ((0 I 0 YOU)
	(NIL)
	(WHY DO YOU THINK I 3 YOU)
	(YOU LIKE TO THINK I 3 YOU - "DON'T" YOU)
	(WHAT MAKES YOU THINK I 3 YOU)
	(REALLY? I 3 YOU)
	(DO YOU WISH TO BELIEVE I 3 YOU)
	(SUPPOSE I DID 3 YOU - WHAT WOULD THAT MEAN)
	(DOES SOMEONE ELSE BELIEVE I 3 YOU))
      ((0 I 1 0)
	(NIL)
	(SUPPOSE YOU 3 4 ".")
	(OH? I 3 4)
	(WHAT MAKES YOU THINK I 3 4)
	(WHO ARE YOU REALLY TALKING ABOUT))))

(RPLQQ XXYYZZ RULES (
      ((0)
	(NIL)
	(IS THERE SOMETHING BOTHERING YOU)
	(CAN YOU BE MORE INFORMATIVE)
	(PERHAPS YOU WOULD RATHER TALK ABOUT SOMETHING ELSE ".")
	(PLEASE TELL ME MORE "."))))

(RPLQQ YES PRIORITY -1 RULES (
      ((0) (NIL)
	XXYYZZ
	(WHY ARE YOU SO SURE)
	(I SEE ".")
	(I UNDERSTAND "."))))

(RPLQQ NO PRIORITY -1 RULES (
      ((0 NO (BODY ONE) 0)
	(NIL)
	NOBODY)
      ((0)
	(NIL)
	XXYYZZ
	(VERY WELL ".")
	(WHY NOT)
	(WHY "'NO'") NEWKEY)))

(RPLQQ CAN PRIORITY 0 RULES (
      ((CAN I 0)
	(NIL)
	(YOU BELIEVE I CAN 3 "DON'T" YOU)
	XXWHAT
	(YOU WANT ME TO BE ABLE TO 3 ".")
	(PERHAPS YOU WOULD LIKE TO BE ABLE TO 3 YOURSELF "."))
      ((CAN YOU 0)
	(NIL)
	(WHETHER OR NOT YOU CAN 3 DEPENDS ON YOU MORE THAN ON ME ".")
	(DO YOU WANT TO BE ABLE TO 3)
	(PERHAPS YOU "DON'T" WANT TO 3 ".")
	XXWHAT)))

(RPLQQ IS PRIORITY 0 RULES (
      ((IS 0)
	(NIL)
	XXWHAT )
      ARE ))

(RPLQQ WHERE PRIORITY 0 RULES (WHAT))

(RPLQQ WHAT PRIORITY 0 RULES (
      (((HOW WHERE WHAT WHY) 0)
	(NIL)
	XXWHAT)))

(RPLQQ XXWHAT RULES (
      ((0)
	(NIL)
	(WHY DO YOU ASK)
	(WHY DOES THAT QUESTION INTEREST YOU)
	(WHY ARE SUCH QUESTIONS ON YOUR MIND)
	(WHAT ANSWER WOULD PLEASE YOU MOST)
	(WHAT DO YOU THINK)
	(WHEN HAVE YOU ASKED SUCH QUESTIONS BEFORE)
	(WHO ELSE HAVE YOU ASKED))))

(RPLQQ BECAUSE PRIORITY 0 RULES (
      ((0)
	(NIL)
	(IS THAT THE REAL REASON)
	(I SEE ".")
	("DON'T" ANY OTHER REASONS COME TO MIND)
	(DOES THAT REASON SEEM TO EXPLAIN ANYTHING ELSE)
	(AND WHAT DOES THAT SUGGEST)
	(WHAT OTHER REASONS MIGHT THERE BE))))

(RPLQQ WHY PRIORITY 0 RULES (
      ((0 WHY ("DON'T" "WON'T") I 0)
	(NIL)
	(DO YOU BELIEVE I "DON'T" 5)
	(PERHAPS I WILL 5 IN GOOD TIME ".")
	(SHOULD YOU 5 YOURSELF)
	(YOU WANT ME TO 5 ".")
	WHAT)
      ((0 WHY "CAN'T" YOU 0)
	(NIL)
	(DO YOU THINK YOU SHOULD BE ABLE TO 5)
	(DO YOU WANT TO BE ABLE TO 5)
	(DO YOU BELIEVE THIS WILL HELP YOU TO 5)
	(HAVE YOU ANY IDEA WHY YOU "CAN'T" 5)
	WHAT )
      WHAT))

(RPLQQ EVERYONE PRIORITY 2 RULES (
      ((0)
	(NIL)
	(CAN YOU THINK OF ANYONE IN PARTICULAR)
	("WHO," FOR EXAMPLE)
	(YOU ARE THINKING OF A VERY SPECIAL PERSON ".")
	(YOU HAVE A PARTICULAR PERSON IN "MIND," "DON'T" YOU) ) ))

(RPLQQ EVERYBODY PRIORITY 2 RULES (EVERYONE))

(RPLQQ NOBODY PRIORITY 2 RULES (
      ((0)
	(NIL)
	(SURELY "SOMEONE...")
	(PERHAPS YOU JUST "DON'T" KNOW OF ANYONE "."))))

(RPLQQ NO-ONE PRIORITY 2 RULES (NOBODY))

(RPLQQ ALWAYS PRIORITY 1 RULES (
      ((0)
	(NIL)
	(CAN YOU THINK OF A SPECIFIC EXAMPLE)
	(WHEN)
	(WHAT INCIDENT ARE YOU THINKING OF)
	("REALLY," ALWAYS) ) ))

(RPLQQ LIKE RULES (
      ((0 (AM IS ARE WAS) 0 LIKE 0)
	(NIL)
	DIT) )
      EMOTION T PRIORITY 3)

(RPLQQ DIT RULES (
      ((0)
	(NIL)
	(IN WHAT WAY)
	(WHAT RESEMBLANCE DO YOU SEE)
	(WHAT DOES THAT SIMILARITY SUGGEST TO YOU)
	(WHAT OTHER CONNECTIONS DO YOU SEE)
	(WHAT IS THE "CONNECTION," DO YOU SUPPOSE)
	(HOW) ) ))

(RPLQQ OH PRIORITY 10 RULES (
      ((0 YOUR OH YOUR 0)
	(NIL)
	(PRE (1 MY-OH-MY 5) NEWKEY) )
      ((0 OH YOUR 0)
	(NIL)
	(PRE (1 OH-MY 4) NEWKEY) ) ))

(RPLQQ EVERY PRIORITY 0 RULES (
      ((0 EVERY (ONE BODY) 0)
	(NIL)
	EVERYONE )
      ((0 EVERY TIME 0)
	(NIL)
	ALWAYS ) ))

(RPLQQ DO PRIORITY 0 RULES (
      ((DO I 0)
	(NIL)
	(PRE (I 3) YOU)
	XXWHAT)
      ((DO YOU 0)
	(NIL)
	(PRE (YOU 3) I)
	XXWHAT) ))

(RPLQQ GIRLS PRIORITY 3 RULES (
      ((0 (GIRLS WOMEN) 0)
	(NIL)
	(PRE (1 2 S 3) BOY) ) ))

(RPLQQ WOMEN PRIORITY 3 RULES (GIRLS))

(RPLQQ BOY PRIORITY 3 PERSON T RULES (
      ((0 (NIL PERSON) FRIEND 0)
	(NIL)
	(I WOULD LIKE TO MEET YOUR 2 FRIEND ".")
	(PRE (1 FRIEND 4) FRIEND)
	(SUPPOSE THE FRIEND WERE NOT A 2 "."))
      ((0 (NIL PERSON) 0)
	(NIL)
	(WHY DO YOU SAY A 2)
	(WHAT 2 ARE YOU THINKING OF)
	NEWKEY)
      ((0 (NIL PERSON) S 0)
	(NIL)
	(WHAT GROUP OF 2 ARE YOU THINKING OF)
	(I EXPECTED THAT YOU WOULD WANT TO TALK ABOUT 2 ".")
	(DO YOU KNOW MANY 2))))

(RPLQQ GIRL PRIORITY 3 PERSON T RULES (BOY))

(RPLQQ MAN PRIORITY 3 PERSON T RULES (BOY))

(RPLQQ WOMEN PRIORITY 3 PERSON T RULES (BOY))

(RPLQQ SEXY PRIORITY 5 RULES (SEX))

(RPLQQ SEXUAL PRIORITY 5 RULES (SEX))

(RPLQQ SEX PRIORITY 5 RULES (
      ((0 YOU 0 SEX 0)
	(NIL)
	(ARE YOU SURE YOU REALLY 3 IT 5)
	(DO YOU REALLY WANT TO DISCUSS SEX)
	(PERHAPS YOU ARE WORRIED THAT YOU 3 IT 5)
	NEWKEY)
      ((0)
	(NIL)
	(WHAT ARE YOUR REAL FEELINGS ABOUT SEX)
	(DO YOU EVER DREAM ABOUT SEX)
	(WHY DO YOU MENTION SEX)
	(COULD SEX BE PART OF YOUR PROBLEM)
	NEWKEY))
    MEMR (
      ((0 YOU 0 SEX 0)
	(NIL)
	(EARLIER YOU SAID YOU 3 4 5 ".")
	(TELL ME AGAIN WHY YOU 3 4 5 ".")
	(DO YOU SAY THAT BECAUSE YOU 3 4 5))))

(RPLQQ FRIENDLY PRIORITY 0 RULES (FRIEND))

(RPLQQ FRIEND PRIORITY 1 RULES (
      ((0 YOUR FRIEND 0)
	(NIL)
	(WHAT ELSE CAN YOU TELL ME ABOUT YOUR FRIEND)
	(WHAT MIGHT YOUR FRIENDS HAVE TO DO WITH YOUR PROBLEM))
      ((0)
	(NIL)
	(DO YOU THINK FRIENDS ARE IMPORTANT)
	(WHAT DO YOU THINK ABOUT YOUR FRIENDS))))

(RPLQQ CRY PRIORITY 2 RULES (LAUGH))

(RPLQQ LAUGH PRIORITY 2 RULES (
      ((0 (LAUGH CRY) 0)
	(NIL)
	(WHAT WOULD MAKE YOU 2)
	(REALLY 2)
	(WOULD YOU LIKE TO LAUGH)
	NEWKEY)))

(RPLQQ LOVE EMOTION T)

(RPLQQ HATE EMOTION T)

(RPLQQ DISLIKE EMOTION NIL)

(PROGN ((GETD 'WINDOWS T))
       (CLOSE-INPUT-FILE (FIND "DOCTOR.LSP" (INPUT-FILES) 'FINDSTRING))
       (DOCTOR) )

(SETQ *INIT-WINDOW* "Doctor")
(SETQ *WINDOW-TYPES* (SORT (ADJOIN "Doctor" *WINDOW-TYPES*) 'STRING<))
(SETQ DRIVER 'WINDOWS)

(DEFUN "Doctor" (COMMAND)
  ((EQ COMMAND 'CREATE-WINDOW)
    (LIST "Doctor") )
  ((EQ COMMAND 'CLOSE-WINDOW))
  ((EQ COMMAND 'UPDATE-WINDOW)
    (DOCTOR-DISPLAY) )
  (DOCTOR-STATUS)
  (LOOP
    (EXECUTE-OPTION 'COMMAND *DOCTOR-OPTIONS*) ) )

(SETQ *DOCTOR-OPTIONS* '(
	("Go" . DOCTOR-RUN)
	("Options" . (
		("Color" . (
			("Menu" . SET-MENU-COLOR)
			("Work" . SET-WORK-COLOR) ))
		("Display" . SET-DISPLAY)
		("Execute" . GO-DOS) ))
	("Quit" . QUIT-PROGRAM)
	("Window" . CHANGE-WINDOW) ))

(DEFUN DOCTOR-RUN (
    *AUTO-NEWLINE*)
  (SHOW-PROMPT "Press ESC for options")
  (CURRENT-WINDOW T)
  (CENTER "The Doctor (Eliza) Program")
  (TERPRI)
  (CURSOR-ON)
  (SETQ *AUTO-NEWLINE* T)
  (DOCTOR)
  (CLEAR-INPUT) )

(DEFUN DOCTOR-STATUS ()
  (CLEAR-STATUS "Doctor")
  (WRITE-STRING "The Doctor (Eliza) Program") )

(DEFUN DOCTOR-DISPLAY ()
  (CURRENT-WINDOW T)
  (CENTER "The Doctor (Eliza) Program")
  (TERPRI 2)
  (WRITE-SENTENCE "This game imitates a psychologist of the Rogerian ")
  (WRITE-SENTENCE "school of psychology who lets the patient resolve ")
  (WRITE-SENTENCE "their own problems by asking a series of leading ")
  (WRITE-SENTENCE "questions.") )

(DEFUN CENTER (MSG)
  (SET-CURSOR (ROW) (TRUNCATE (- (CADDDR (MAKE-WINDOW)) (LENGTH MSG)) 2))
  (WRITE-SENTENCE MSG) )

(PROGN
  (TERPRI)
  (WRITE-SENTENCE "Press the ESC key and open a \"Doctor\" window ")
  (WRITE-SENTENCE "to start the Doctor (Eliza) Program.")
  (TERPRI) )
